home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
aie9009.zip
/
FRAMES.ZIP
/
NEWFRAME.ARI
< prev
next >
Wrap
Text File
|
1990-07-09
|
17KB
|
693 lines
% FRAME LIBRARY
%
% by
%
% Instant Recall
% P.O. Box 30134
% Bethesda, Md. 20814
% (301) 530-0898
% BBS: (301) 530-2890
%
% (C) Copyright 1990 by Instant Recall
% All Rights Reserved
:- module newframe.
:- segment(libseg).
/*
* get slot value
* get slot value with default
* get slot values
* has slot
* index frame into database
* learn indexed frame update
* retrieve frame from database
* retrieve indexed frame
* retrieve or create indexed frame
satisfies pattern,
types match$,
*/
:- public frame_op / 2 : far .
:- public frame_op / 3 : far .
:- public frame_op / 4 : far .
:- public frame_op / 5 : far .
:- public frame_op / 6 : far .
:- visible frame_op / 2 .
:- visible frame_op / 3 .
:- visible frame_op / 4 .
:- visible frame_op / 5 .
:- visible frame_op / 6 .
:- extrn append / 3 : far .
:- extrn trace_message / 3 : far .
:- extrn frame_op / 0 : interp .
%%%%%%%%%%%%%%%%% IMPLEMENTATIONS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%% frame_op / 2 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%% frame_op / 2 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- mode frame_op( +,+).
frame_op( KEY,
FRAME2 ) :-
ARGS = FRAME2 ,
frame_op( $trace$,
KEY,
ARGS ) ,
fail.
frame_op( $purge database$,
PATTERN ) :-
frame_op( $retrieve frame from database$,
PATTERN,
RETRIEVED_FRAME ) ,
retract( RETRIEVED_FRAME ),
fail.
frame_op( $purge database$,
_ ) :-!.
%%%%%%%%%%%%%%%%% frame_op / 3 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%% frame_op / 3 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- mode frame_op( +,+,?).
% cl 0
frame_op( $trace$,
KEY,
ARGS ) :-
!,
( call( frame_op ),
!,
concat( [$e $, KEY , $ args = $], MSG ),
trace_message( frame_op,
MSG,
ARGS)
;
true
).
frame_op( $x trace$,
KEY,
ARG ) :-
!,
( call( frame_op ),
!,
concat( [$x $, KEY , $ RESULT = $], MSG ),
trace_message( frame_op,
MSG,
ARG)
;
true
).
frame_op( KEY,
FRAME1 ,
FRAME2 ) :-
ARGS = [ FRAME1, FRAME2 ],
frame_op( $trace$,
KEY,
ARGS ) ,
fail.
frame_op( $learn prolog database frame update$,
PATTERN,
NEW_FRAME ) :-
frame_op( $purge database$,
PATTERN ) ,
asserta( NEW_FRAME ) .
% cl 1
frame_op( $types match$,
FRAME1 ,
FRAME2 ) :-
frame_op( $frame info$,
FRAME1 ,
FUNCTOR1,
_ ) ,
frame_op( $frame info$,
FRAME2 ,
FUNCTOR2,
_ ) ,
frame_op( $unify types$,
FUNCTOR1,
FUNCTOR2,
_ ),
frame_op( $x trace$,
$types match$,
true ) .
% cl 2
frame_op( $satisfies pattern$,
FRAME,
PATTERN ) :-
frame_op( $types match$,
FRAME,
PATTERN ) ,
frame_op( $get slot values$,
FRAME,
PATTERN ,
_ ) ,
frame_op( $x trace$,
$satisfies pattern$,
true ) .
% cl 3
frame_op( $retrieve frame from database$,
PATTERN,
RETRIEVED_FRAME ) :-
PATTERN =.. [ FUNCTOR , SLOTS ] ,
RETRIEVED_FRAME =.. [ FUNCTOR, _ ],
call( RETRIEVED_FRAME ),
frame_op( $get slot values$,
RETRIEVED_FRAME ,
SLOTS ),
frame_op( $x trace$,
$retrieve frame from database$,
RETRIEVED_FRAME ) .
% cl 4
frame_op( $index frame into database$,
KEY,
FRAME ) :-
recordz( KEY, FRAME , _ ) ,
frame_op( $x trace$,
$index frame into database$,
FRAME ) .
% cl 5
frame_op( $has slot$,
FRAME,
SLOT ) :-
frame_op( $get slot value$,
FRAME,
SLOT,
_ ) ,
frame_op( $x trace$,
$has slot$,
true ) .
% this less elabaorate form can not have the
% optional and unacceptable modifiers in the
% SLOTS TO GET
% cl 7
frame_op( $get slot values$,
_ , % SOURCE_FRAME,
[] ):- !,
frame_op( $x trace$,
$get slot values$,
[] ) .
frame_op( $get slot values$,
SOURCE_FRAME,
OUTPUT ):-
OUTPUT = [S : V | R ] ,
frame_op( $get slot value$,
SOURCE_FRAME,
S,
V),
frame_op( $get slot values$,
SOURCE_FRAME,
R ) ,
frame_op( $x trace$,
$get slot values$,
OUTPUT ) .
% cl 8
frame_op( $get pair slot$,
PAIR ,
SLOT ) :-
PAIR = SLOT : _ ,
frame_op( $x trace$,
$get pair slot$,
SLOT ) .
%%%%%%%%%%%%%%%%% frame_op / 4 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%% frame_op / 4 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- mode frame_op( +,+,+,?).
%%%%%%%%%%%%%%%%%%% retrieve or create indexed frame %%%%%%%%%%%%
frame_op( KEY,
FRAME1 ,
FRAME1a ,
FRAME2 ) :-
ARGS = [ FRAME1, FRAME1a, FRAME2 ],
frame_op( $trace$,
KEY,
ARGS ) ,
fail.
% cl 1
frame_op( $retrieve or create indexed frame$,
KEY ,
PATTERN ,
FRAME ) :-
frame_op( $retrieve indexed frame$,
KEY ,
PATTERN ,
FRAME ) ,
!,
frame_op( $x trace$,
$retrieve or create indexed frame$,
FRAME ) .
% cl 2
frame_op( $retrieve or create indexed frame$,
KEY ,
PATTERN ,
PATTERN ) :-
recorda( KEY, PATTERN , _ ),
frame_op( $x trace$,
$retrieve or create indexed frame$,
PATTERN ) .
% cl 3
frame_op( $retrieve indexed frame$,
KEY ,
PATTERN ,
RETRIEVED_FRAME ) :-
PATTERN =.. [ FUNCTOR , SLOTS ] ,
RETRIEVED_FRAME =.. [ FUNCTOR, _ ],
recorded( KEY, RETRIEVED_FRAME, _ ),
frame_op( $get slot values$,
RETRIEVED_FRAME ,
SLOTS ),
frame_op( $x trace$,
$retrieve indexed frame$,
RETRIEVED_FRAME ) .
% cl 4
frame_op( $frame info$,
FRAME ,
FUNCTOR ,
SLOTS ) :-
( ( FRAME = [ _ | _ ]
;
FRAME = []
),
!,
SLOTS = FRAME,
FUNCTOR = untyped
;
FRAME =.. [ FUNCTOR , SLOTS ]
),
!,
frame_op( $x trace$,
$frame info$,
SLOTS ) .
%%%%%%%%%%%%%%%%%%% get slot value %%%%%%%%%%%%%%%%%%%
% cl 5
frame_op( $get slot value$,
[ SLOT : VALUE | _ ],
SLOT,
VALUE ) :- !,
frame_op( $x trace$,
$get slot value$,
VALUE ) .
% cl 6
frame_op( $get slot value$,
[ _ | REST ],
SLOT,
VALUE ) :-
!,
frame_op( $get slot value$,
REST ,
SLOT,
VALUE ) ,
frame_op( $x trace$,
$get slot value$,
VALUE ) .
% cl 7
frame_op( $get slot value$,
TERM ,
SLOT,
VALUE ) :-
TERM =..[ _ , SLOTS ],
!,
frame_op( $get slot value$,
SLOTS ,
SLOT,
VALUE ) ,
frame_op( $x trace$,
$get slot value$,
VALUE ) .
%%%%%%%%%%%%%%%%%%% get slot values %%%%%%%%%%%%%%%%%%%
frame_op( $get slot values$,
SOURCE_FRAME,
SLOTS_TO_GET,
RESULTING_SLOT_LIST ) :-
var( SLOTS_TO_GET ),
!,
frame_op( $frame info$,
SOURCE_FRAME,
_,
RESULTING_SLOT_LIST ),
frame_op( $x trace$,
$get slot values$,
RESULTING_SLOT_LIST ) .
% cl 8
frame_op( $get slot values$,
_ , % SOURCE_FRAME,
SLOTS_TO_GET,
RESULTING_SLOT_LIST ) :-
SLOTS_TO_GET = [],
!,
RESULTING_SLOT_LIST = [],
frame_op( $x trace$,
$get slot values$,
RESULTING_SLOT_LIST ) .
% cl 9
frame_op( $get slot values$,
SOURCE_FRAME,
SLOTS_TO_GET,
RESULTING_SLOT_LIST ) :-
SLOTS_TO_GET = [ PAIR | REST ],
frame_op( $get pair slot$,
PAIR ,
SLOT ) ,
frame_op( $get pair value$,
SOURCE_FRAME,
SLOT ,
PAIR ,
VALUE ) ,
RESULTING_SLOT_LIST = [ SLOT : VALUE | REST1 ],
frame_op( $get slot values$,
SOURCE_FRAME,
REST ,
REST1 ),
frame_op( $x trace$,
$get slot values$,
RESULTING_SLOT_LIST ) .
% cl 10
% cl 11
frame_op( $unify frames$,
FRAME1 ,
FRAME2 ,
NEW_FRAME ) :-
frame_op( $frame info$,
FRAME1 ,
FUNCTOR1,
SLOTS1) ,
frame_op( $frame info$,
FRAME2 ,
FUNCTOR2,
SLOTS2) ,
frame_op( $unify types$,
FUNCTOR1,
FUNCTOR2,
NEW_TYPE ),
frame_op( $unify slots in frame1$,
SLOTS1 ,
SLOTS2 ,
NEW_SLOTS1 ),
frame_op( $unify slots in frame2$,
SLOTS1 ,
SLOTS2 ,
NEW_SLOTS2 ),
append( NEW_SLOTS1 ,
NEW_SLOTS2 ,
NEW_SLOTS ),
( NEW_TYPE == untyped ,
!,
NEW_FRAME = NEW_SLOTS
;
NEW_FRAME =..[ NEW_TYPE, NEW_SLOTS ]
),
frame_op( $x trace$,
$unify frames$,
NEW_FRAME ) .
% cl 12
frame_op( $unify types$,
untyped ,
FUNCTOR2,
FUNCTOR2 ) :- !,
frame_op( $x trace$,
$unify types$,
FUNCTOR2 ) .
% cl 13
frame_op( $unify types$,
FUNCTOR1,
untyped ,
FUNCTOR1 ) :- !,
frame_op( $x trace$,
$unify types$,
FUNCTOR1 ) .
% cl 14
frame_op( $unify types$,
FUNCTOR1,
FUNCTOR1,
FUNCTOR1 ) :- !,
frame_op( $x trace$,
$unify types$,
FUNCTOR1 ) .
% cl 15
frame_op( $unify slots in frame1$,
SLOTS1 ,
_ ,
NEW_SLOTS1 ) :-
SLOTS1 = [] ,
!,
NEW_SLOTS1 = [] ,
frame_op( $x trace$,
$unify slots in frame1$,
NEW_SLOTS1 ) .
% cl 16
frame_op( $unify slots in frame1$,
SLOTS1 ,
SLOTS2 ,
NEW_SLOTS1 ) :-
SLOTS1 = [ SLOT : VALUE1 | REST ],
frame_op( $get slot value with default$,
SLOTS2 ,
SLOT,
VALUE1 ,
VALUE2 ) ,
VALUE2 = VALUE1 ,
NEW_SLOTS1 = [ SLOT : VALUE1 | REST1 ],
frame_op( $unify slots in frame1$,
REST ,
SLOTS2 ,
REST1 ) ,
frame_op( $x trace$,
$unify slots in frame1$,
NEW_SLOTS1 ) .
% cl 17
frame_op( $unify slots in frame2$,
_ ,
SLOTS2 ,
NEW_SLOTS2 ) :-
SLOTS2 = [],
!,
NEW_SLOTS2 = [] ,
frame_op( $x trace$,
$unify slots in frame2$,
NEW_SLOTS2 ) .
% cl 18
frame_op( $unify slots in frame2$,
SLOTS1 ,
SLOTS2 ,
NEW_SLOTS2 ) :-
SLOTS2 = [ SLOT : VALUE1 | REST ],
( frame_op( $has slot$,
SLOTS1 ,
SLOT ),
!,
frame_op( $unify slots in frame2$,
SLOTS1 ,
REST ,
NEW_SLOTS2 )
;
NEW_SLOTS2 = [ SLOT : VALUE1 | COMPUTED_REST ],
frame_op( $unify slots in frame2$,
SLOTS1 ,
REST ,
COMPUTED_REST )
),
frame_op( $x trace$,
$unify slots in frame2$,
NEW_SLOTS2 ) .
%%%%%%%%%%%%%%%%% frame_op / 5 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%% frame_op / 5 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- mode frame_op( +,+,+,+,?).
frame_op( KEY,
FRAME1 ,
FRAME1a ,
FRAME1b ,
FRAME2 ) :-
ARGS = [ FRAME1, FRAME1a , FRAME1b , FRAME2 ],
frame_op( $trace$,
KEY,
ARGS ) ,
fail.
frame_op( $get pair value$,
SOURCE_FRAME,
SLOT ,
PAIR ,
VALUE ) :-
PAIR = _ : REST ,
/*-TRACE-*/ trace_message( frame_op ,
/*-TRACE-*/ $...REST = $,
/*-TRACE-*/ REST ),
(
var( REST ),
!,
frame_op( $get slot value$,
SOURCE_FRAME,
SLOT,
VALUE )
;
% PAIR = SLOT : unacceptable : BAD_VALUE ,
REST = unacceptable : BAD_VALUE ,
!,
(
frame_op( $get slot value$,
SOURCE_FRAME,
SLOT,
VALUE ) ,
!,
not BAD_VALUE = VALUE
;
true
)
;
% PAIR = SLOT : optional : VALUE
REST = optional : GOOD_VALUE ,
! ,
(
frame_op( $get slot value$,
SOURCE_FRAME,
SLOT,
VALUE ) ,
!,
GOOD_VALUE = VALUE
;
true
)
) ,
frame_op( $x trace$,
$get pair value$,
VALUE ) .
%%%%%%%%%%%%%%%%%%% learn indexed frame update %%%%%%%%%%%%%%%%%%%
% cl 1
frame_op( $learn indexed frame update$,
KEY ,
OLD_FRAME ,
NEW_SLOTS ,
NEW_FRAME ) :-
frame_op( $unify frames$,
OLD_FRAME ,
NEW_SLOTS ,
NEW_FRAME ) ,
recorded( KEY, OLD_FRAME, REF ),
replace( REF, NEW_FRAME ),
frame_op( $x trace$,
$learn indexed frame update$,
NEW_FRAME ) .
%%%%%%%%%%%%%%%%%%% get slot value with default %%%%%%%%%%%%%%%%%%%
% cl 2
frame_op( $get slot value with default$,
FRAME,
SLOT,
_ , % DEFAULT,
VALUE ) :-
frame_op( $get slot value$,
FRAME,
SLOT,
VALUE ) ,
!,
frame_op( $x trace$,
$get slot value with default$,
VALUE ) .
% cl 3
frame_op( $get slot value with default$,
_ ,
_ ,
DEFAULT,
DEFAULT ) :- !,
frame_op( $x trace$,
$get slot value with default$,
DEFAULT ) .
%%%%%%%%%%%%%%%%% frame_op / 6 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%% frame_op / 6 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- mode frame_op( +,+,+,+,+,?).
frame_op( KEY,
FRAME1 ,
FRAME1a ,
FRAME1b ,
FRAME1C ,
FRAME2 ) :-
ARGS = [ FRAME1, FRAME1a , FRAME1b , FRAME1C , FRAME2 ],
frame_op( $trace$,
KEY,
ARGS ) ,
fail.
frame_op( $learn indexed and Prolog database frame update$,
KEY ,
PATTERN ,
OLD_OBJECT ,
SLOTS ,
NEW_STATEMENT_OBJECT ) :-
frame_op( $learn indexed frame update$,
KEY ,
OLD_OBJECT ,
SLOTS ,
NEW_STATEMENT_OBJECT ),
frame_op( $learn prolog database frame update$,
PATTERN,
NEW_STATEMENT_OBJECT ) .
%%%%%%%%%%%%%%%%%%%%%%%%%% eof %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%